00100	TITLE  TEST
00200	EXTERNAL PASS3,occult,PASS5,PASS6,NUMTRI,TRITAB
00210	
00300	INTERNAL STOP,GO,PATCH
00400	GO:	JUMP
00500		JSR PASS3
00600		JSR occult
00700		JSR PASS5
00800		JSR PASS6
00900	STOP:	HALT
00940	PATCH:
01000	BLOCK 100
01100	END GO
     

00100	TITLE PASS3
00200	EXTERNAL TRIBLKS,TRITAB,INPUT3,NUMTRI
00300	INTERNAL PASS3
00400	PASS3:	0
00500		SETZM NLEAST#	;COUNT OF TRIANGLES
00600	OPDEF OUTSTG [XWD 051140,0]
00700	;ACCUMULATORS
00800	A←←XY1←←KA←←0
00900	B←←XY2←←AC0←←LA←←1
01000	C←←XY3←←AC1←←2
01100	AA←←I1←←Z12←←LO←←LB←←KB←←3
01200	BB←←I2←←Z3I←←HI←←4
01300	CC←←I3←←C12←←MID←←5
01400	X1←←AB1←←6
01500	X2←←AB2←←7
01600	X3←←AB3←←10
01700	Y1←←AB←←11
01800	Y2←←CC3←←12
01900	Y3←←13
02000	Z1←←Z←←14
02100	Z2←←TRI←←15
02200	Z3←←LC←←16
02300	ZT←←QB←←II←←KK←←KC←←17
02400	KPLANE←1
     

00100	LOOP:	MOVE QB,NLEAST		;DONE YET  
00200		CAML QB,NUMTRI
00300		JRST @PASS3
00400	;BLIT TRIANGLE BLOCK INTO AC'S
00500		IMULI QB,5
00600		ADDI QB,INPUT3
00700		MOVSS QB
00800		BLT QB,4
00900	;UNPACK TRIANGLE BLOCK
01000		FOR @$ I←1,3 {
01100		HLRE X$I,XY$I
01200		HRRE Y$I,XY$I ⎇
01300		HLRE Z1,Z12
01400		HRRE Z2,Z12
01500		HLRE Z3,Z3I
01600		HRRZ II,Z3I
01700	P3B:
01800		TRNE II,4 ↔ SKIPA I1,[1] ↔ SETZ I1,
01900		TRNE II,2 ↔ SKIPA I2,[1] ↔ SETZ I2,
02000		TRNE II,1 ↔ SKIPA I3,[1] ↔ SETZ I3,
02100	P3A:
02200	;ORDER Z1 LEAST, Z3 MOST.
02300	DEFINE SWAP $ (N,M) {
02400	CAMG Z$N,Z$M
02500	JRST .+5
02600	EXCH X$N,X$M
02700	EXCH Y$N,Y$M
02800	EXCH Z$N,Z$M
02900	EXCH I$N,I$M ⎇
03000	SWAP 1,2
03100	SWAP 2,3
03200	SWAP 1,2
03300	
03400	MOVE II,I1	;RE-PACK I-BITS
03500	LSH  II,1
03600	IOR  II,I2
03700	LSH  II,1
03800	IOR  II,I3
03900	
04000	EXCH II,[KPLANE]
     

00100	;CALCULATE COEFFICIENTS OF THE PLANE OF THE TRIANGLE BY KRAMER'S RULE.
00200	DEFINE DET2B2 (A00,B11,B12,B21,B22) {
00300	MOVE B,B11
00400	MOVE C,B12
00500	IMUL B,B22
00600	IMUL C,B21
00700	SUB B,C
00800	IMUL B,A00 ⎇
00900	
01000	DEFINE DETERM (A11,A12,A13,A21,A22,A23,A31,A32,A33) {
01100	DET2B2 A11,A22,A23,A32,A33
01200	MOVE A,B
01300	DET2B2 A12,A21,A23,A31,A33
01400	SUB A,B
01500	DET2B2 A13,A21,A22,A31,A32
01600	ADD A,B ⎇
01700	
01800	DETERM KK,Y1,Z1,KK,Y2,Z2,KK,Y3,Z3
01900	MOVE AA,A
02000	DETERM X1,KK,Z1,X2,KK,Z2,X3,KK,Z3
02100	MOVE BB,A
02200	DETERM X1,Y1,KK,X2,Y2,KK,X3,Y3,KK
02300	MOVE CC,A
02400	DETERM X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
02500	MOVEM A,KSAVE#
02600	BRK:
03350	;HALFWORD OVERFLOW.
03500	DEFINE HALFOV (W,WW){
03600	MOVM W,WW
03700	CAIGE W,400000
03800	JRST .+10
03900	MOVE W,KSAVE	;OVERFLOW
03910	ASH W,-1
03920	MOVEM W,KSAVE
03930	ASH AA,-1
03940	ASH BB,-1
03950	ASH CC,-1
04350	JRST .-11
04400	⎇
04500	HALFOV A,AA
04600	HALFOV B,BB
04700	HALFOV C,CC
04800	P3C:
04900	;PACK PLANE COEFFICIENTS
05000	HRL BB,AA
05100	HRLS CC
05200	EXCH KK,[KPLANE]		;COL-1
     

00100	;CALCULATE LINE COEFFICIENTS
00200	DEFINE LINCOE (X1,X2,Y1,Y2,TA,TB,TC,X3,Y3) {
00300	MOVE TA,Y2
00400	MOVE TB,X1
00500	SUB TA,Y1	;(Y2-Y1)=a
00600	SUB TB,X2	;(X1-X2)=b
00700	HRL TC,TA
00800	HRR TC,TB
00900	IMUL TA,X1	; A*x1	
01000	IMUL TB,Y1	; B*y1
01100	ADD TA,TB
01200	MOVNS TA
01300	MOVM TB,TA
01400	CAIGE TB,400000
01500	JRST .+6
01600	HLRE TA,TC	;HALFWORD OVERFLOW CURE
01700	HRRE TB,TC
01800	ASH TA,-1
01900	ASH TB,-1
02000	JRST .-15	;JUMP TO THE  "HRL" ABOVE.
02100		;TA    c
02200		;TB    free
02300		;TC    a,,b
02400	;observe qqq sign convention  -  odd vertex positive.
02500		HLRE TB,TC
02600		IMUL TB,X3
02700		MOVEM TB,AC20
02800		HRRE TB,TC
02900		IMUL TB,Y3
03000		ADD TB,AC20
03100		ADD TB,TA
03200		JUMPGE TB,.+7
03300		MOVNS TA	;FLIP SIGN OF LINE COEFFICIENTS.
03400		HLRE TB,TC
03500		HRRE TC,TC
03600		MOVNS TB
03700		MOVNS TC
03800		HRL TC,TB
03900	⎇
04000	HRL QB,Z3
04100	LINCOE X1,X2,Y1,Y2,A,B,C,X3,Y3
04200	LINCOE X1,X3,Y1,Y3,LA,LB,LC,X2,Y2	;COL-2
04300	HRR CC,A	;PACK c3
04400	MOVEM KC,SAVKC#
04500	LINCOE X2,X3,Y2,Y3,KA,KB,KC,X1,Y1	;COL-4
04600	HRL Y1,X1
04700	MOVE X1,KC
04800	MOVE KC,SAVKC
     

00100	P3D:
00200	;PACK EVERYTHING INTO YOUR OLD KIT BAG AND SMILE SMILE SMILE
00300	; WOULD YOU BELIEVE A LONG TRIANGLE BLOCK   
00400	HRL Y2,X2
00500	HRL Y3,X3
00600	MOVE AB2,LC
00700	MOVE AB3,C
00800	MOVE 2,13
00900	HRL 1,0
01000	HRL 3,14
01100	HRR 3,15
01200	MOVE 0,11
01300	EXCH 1,12
01400	EXCH 5,12
01500	MOVE 11,4
01600	MOVE 4,17
01700	MOVE 13,KSAVE
01800	
01900	;BLIT BLOCK INTO LONG BLOCK TABLE.
02000	MOVE 17,NLEAST
02100	IMULI 17,14
02200	ADDI 17,TRIBLKS
02300	MOVE 16,17
02400	ADDI 16,13
02500	BLT 17,@16
     

00100	P3E:
00200	;PUT TRIANGLE BLOCK POINTER INTO THE TRIANGLE TABLE
00300	;IN ORDER ON MINIMUM DEPTH.
00400		HRL ZT,Z
00500		MOVE TRI,NUMTRI
00600		SKIPN LO,NLEAST
00700		JRST [AOS NLEAST		;FIRST TIME ONLY.
00800			MOVEM ZT,TRITAB-1(TRI)
00900			JRST LOOP]
01000		SETZ HI,
01100	PUT1:	MOVE MID,LO	;MID:=(LO+HI+1)/2
01200		ADD MID,HI
01300		AOS MID
01400		ASH MID,-1
01500		MOVE LC,TRI	;FETCH Z(MID)
01600		SUB LC,MID
01700		HLRE A,TRITAB(LC)
01800		CAML Z,A
01900		JRST [CAMN LO,MID
02000			JRST PUT2
02100			CAMN HI,MID
02200			JRST PUT2
02300			MOVE LO,MID
02400			JRST PUT1]
02500		CAMN LO,MID
02600		JRST [AOS MID
02700			JRST PUT2]
02800		CAMN HI,LO
02900		JRST [AOS MID
03000			JRST PUT2]
03100		MOVE HI,MID
03200		JRST PUT1
03400	;MOVE THE LOWER PART OF THE TRIANGLE TABLE,
03500	;BETWEEN NLEAST AND MID,
03600	;DOWN CORE BY ONE WORD.
03800	PUT2:	CAMLE MID,NLEAST
03900		JRST PUT3
04000		MOVEI AC0,TRITAB
04100		ADD AC0,TRI
04200		MOVE AC1,AC0
04300		SUB AC0,NLEAST
04400		HRLS AC0
04500		SOS AC0
04600		SUB AC1,MID
04700		SOS AC1
04800		BLT AC0,@AC1
04900	PUT3:	AOS NLEAST
05000		SUB TRI,MID
05100		MOVEM ZT,TRITAB(TRI)
05200		JRST LOOP
05300	AC20:	0
05400	END
     

00100	TITLE OCCULT
00200	EXTERNAL NUMTRI,OUTPDL,TRITAB,ENDPDL
00300	INTERNAL OCCULT
00400	OPDEF OUTSTR[XWD 5114,0]
00500	;USE AND ABUSE OF ACCUMULATORS
00600	AC0←←0
00700	AC1←←1
00800	XM←←0
00900	YM←←1
01000	
01100	XL←2		;The window.
01200	XH←3
01300	YL←4
01400	YH←5
01500	
01600	X1←AA←←6	;The triangle.
01700	X2←BB←←7
01800	X3←CC←←10
01900	
02000	Y1←MINZ←←11
02100	Y2←MAXZ←←12
02200	Y3←13
02300	
02400	AB←←14		;Plane coefficients.
02500	C←←15
02600	
02700	T←16
02800	TT←17
03000	
03100	XO←←14
03200	YO←←15
03300	PB←←17
03400	
03500	ODD←←13
03600	NEW←←14
03700	OLD←←15
03800	
03900	XY←←11
04000	X←←6
04100	Y←←7
04200	Z←←10
04300	EPTR←←14
04400	BPTR←←15
04500	CTB←←17
     

00100	;O.O.R. - Occult Object Remover.
00200	OCCULT:	0
00300		hrl TT,numtri		;Triangle pointer.
00400		movns TT	;This op covertly Subtracts one from left half.
00500		hrri TT,tritab-1
00600		movem TT,triptr#
00700	
00800		movni XL,1000		;first window
00900		movei XH,1000
01000		movni YL,1000
01100		movei YH,1000
01200		FOR W IN (PENOLD,PENNEW,SUR,SUR3,APEN,ASUR,ASUR3){
01300		SETZM W}
01400		movei 377777
01500		movem ZH#
01600		movei sqrpdl+1
01700		movem sqrpdl
01800		movei outpdl+1
01900		movem outpdl
02000		jrst .V
02100	;Occult Window Loop.
02200	OWLOOP:	sos 1,sqrpdl
02300		caig 1,sqrpdl+1
02400		jrst @occult	;no more windows.
02500	
02600		hlre XL,-5(1)	;new window
02700		hrre XH,-5(1)
02800		hlre YL,-4(1)
02900		hrre YH,-4(1)
03000	
03100		hrre -3(1)	;back limit.
03200		movem ZH
03300	
03400		move (1)	;triangle pointer
03500		movem triptr
03600	
03700		move -2(1)	;ancesters
03800		movem apen#
03900		move -1(1)
04000		movem asur#
04100		hlrz -3(1)
04200		movem asur3#
04300	
04400		setzm pennew#	;descendants
04500		setzm penold#
04600		setzm sur#
04700		setzm sur3#
04800	
04900		subi 1,5
05000		movem 1,sqrpdl
05100		jrst .V
     

00100	;Virgin  -  scan for first triangle.
00200	.V:	jsr pns
00300		jrst [	movem minz,penzlo#
00400			movem maxz,penzhi#
00500			movem T,pennew
00600			jrst .P]
00700		jrst owloop
00800		movem minz,surzlo#
00900		movem maxz,surzhi#
01000		hrlzm T,sur
01200	;One surrounder.
01300	.S:	jsr pns
01400		jrst [	caml minz,surzhi
01500			jrst .S			;B - penetrator is behind surrounder.
01600			movem T,pennew
01700			caml maxz,surzlo
01800			jrst %PS		;C - penetrator and surrounder conflict.
01900			movem minz,penzlo	;F - penetrator is in Front of surrounder
02000			movem maxz,penzhi
02100			jrst .SP]
02200		jrst alpha		;DISPLAY a surrounder.
02300		caml minz,surzhi
02400		jrst .S			;B - new surrounder is behind old surrounder.
02500		caml maxz,surzlo
02600		jrst [	movem minz,zlo#	;C - surrounders conflict.
02700			movem maxz,zhi#
02800			hrrm T,sur
02900			jrst .SS]
03000		movem minz,surzlo	;F - new surrounder is in front of old surrounder
03100		movem maxz,surzhi
03200		hrlm T,sur
03300		jrst .S
03400	
03500	;One Penetrator.
03600	.P:	jsr pns
03700		jrst [movem T,penold
03800		camle minz,penzhi
03900		jrst %PP		;B
04000		caml maxz,penzlo
04100		jrst .PP		;C
04200		jrst %PP]		;F
04300	
04400		jrst beta		;DISPLAY penetrator.
04500	
04600		movem minz,surzlo
04700		movem maxz,surzhi
04800		hrlzm T,sur
04900		caml minz,penzhi
05000		jrst .PS		;B
05100		caml maxz,penzlo
05200		jrst %PS		;C
05300		setzm pennew		;F
05400		jrst .S
05500	
05600	;Two surrounders.
05700	.SS:	jsr pns
05800		jrst [	caml minz,surzhi
05900			jrst .SS	;B
06000			caml minz,zhi	;F & C
06100			jrst .SS	;b
06200			movem T,pennew	;f & c
06300			jrst %PSS]
06400		jrst gamma		;DISPLAY two penetrators.
06500	
06600		caml minz,surzhi
06700		jrst .SS		;B
06800		caml maxz,surzlo
06900		jrst [	caml minz,zhi	;C
07000			jrst .SS	;b
07100			caml maxz,zlo
07200			jrst [	hrrzm T,sur3	;c
07300				jrst %SSS]
07400			hrrm T,sur
07500			movem minz,zlo
07600			movem maxz,zhi
07700			jrst .SS]
07800		caml minz,zhi
07900		jrst .SS
08000		caml maxz,zlo
08100		jrst [	hrlm T,sur	;c
08200			movem minz,surzlo
08300			movem maxz,surzhi
08400			jrst .SS]
08500		hrlzm T,sur		;f
08600		movem minz,surzlo
08700		movem maxz,surzhi
08800		jrst .S
08900	
     

00100	;A surrounder behind a penetrator.
00200	.PS:
00300	.SP:	jsr pns
00400		jrst [	caml minz,surzhi
00500			jrst .PS	;B
00600			movem T,penold
00700			caml maxz,surzlo
00800			jrst %PPS	;C
00900			camle minz,penzhi	;F
01000			jrst %PP	;b
01100			caml minz,penzlo
01200			jrst .PP	;c
01300			jrst %PP]	;f
01400		
01500		jrst beta		;DISPLAY.
01600	
01700		caml minz,surzhi
01800		jrst .PS		;B
01900		caml maxz,surzlo
02000		jrst [	hrrm T,sur	;C
02100			jrst %PSS]
02200		hrlm T,sur		;F
02300		movem minz,surzlo
02400		movem maxz,surzhi
02500		caml minz,penzhi
02600		jrst .PS		;B
02700		caml maxz,penzlo
02800		jrst %PS		;C
02900		setzm pennew		;F
03000		jrst .S
03100	
03200	
03300	SQRPDL:	.+1	;WINDOW SQUARE IN CORE PUSHDOWN LIST
03400		0	; XL XH
03500		0	; YL YH
03600		0	;sur3,,ZH
03700		0	; PEN1,,PEN2
03800		0	; SUR1,,SUR2
03900		0	; TRIPTR
04000	BITS←←=10	;NUMBER OF BITS OF DISPLAY RASTER.
04100		BLOCK (BITS*3+1)*6
04200	SQREND:
04300	FACES←←12	;CORNER PENETRATION DATA AREA
04400	CORPDL:	.+1
04500		BLOCK FACES
04600	PENPDL:	.+1
04700		BLOCK FACES
04800	CTBPTR:	.+1
04900		BLOCK FACES*13
     

00100	;Display output one-surrounder.
00200	ALPHA:	HLRZ T,SUR
00350		MOVEM T,PENNEW
00400	;DISPLAY OUTPUT ONE-PENETRATOR.
00500	BETA:	MOVE AC0,XH
00600		SUB  AC0,XL
00700		HRLM AC0,@OUTPDL
00800		MOVE AC1,PENNEW
00900		HRRM AC1,@OUTPDL
01000		AOS  OUTPDL
01100		HRLM XL,@OUTPDL
01200		HRRM YL,@OUTPDL
01300		AOS  OUTPDL
01400		JRST OWLOOP
01500	
01600	;DISPLAY OUTPUT TWO-SURROUNDERS
01700	GAMMA:	MOVE AC0,XH
01800		SUB  AC0,XL
01900		TRO  AC0,400000
02000		HRLM AC0,@OUTPDL
02100		HLRZ 1,SUR
02200		HRRM AC1,@OUTPDL
02300		AOS OUTPDL
02400		HRLM XL,@OUTPDL
02500		HRRM YL,@OUTPDL
02600		AOS  OUTPDL
02700		HRRZ 1,SUR
02800		HRRZM AC1,@OUTPDL
02900		AOS  OUTPDL
03000		HLRZ SUR
03002		HRRZ 1,SUR
03004		MOVEM PENOLD
03006		MOVEM 1,PENNEW
03100	;Display two penetrators.
03200	EPSILON:
03300		MOVE XH
03400		SUB XL
03500		HRLM @OUTPDL
03600		MOVE 1,PENOLD
03700		HRRM 1,@OUTPDL
03800		AOS OUTPDL
03900		HRLM XL,@OUTPDL
04000		HRRM YL,@OUTPDL
04100		AOS OUTPDL
04200		JRST BETA
     

00100	;OCCUPATION VOLUME
00200	
00300	;		Compute the occupation volume of the Triangle pointed
00400	;to by T for the window XL XH YL YH, find the minimum and maximum Z for all
00500	;corners of the window without exceeding the triangle's total volume z1
00600	;minimum to z3 maximum; if you are worth anything you have by now realized
00700	;that this will yield too large a volume for numerous penetrator cases
00800	;where the vertices aren't in the window and the corners aren't in the triangle
00900	;but it doesn't matter and will all come out correctly further along.
01000	
01100	OCCVOL:	0
01200		HLRE AA,11(T)		;PICKUP COEFFICIENTS OF TRIANGLE'S  PLANE.
01300		HRRE BB,11(T)
01400		HLRE CC,12(T)		
01500		SETCM T
01600		TLNE (5B2)	;IF EXTREME VERTICES ARE WITHIN...
01700		JRST .+4
01800		HLRE MINZ,3(T)	;THEN OCCUPATION VOLUME IS OBVIOUS.
01900		HLRE MAXZ,4(T)
02000		JRST @OCCVOL
02100		HRLZI MAXZ,400000	;Z1
02200		SETCAM MAXZ,MINZ	;Z3
02300	;calculte z-depth of window corners in the plane of the triangle.
02400	FOR I←0,3 
02500	{
02600		MOVE AC0,13(T)
02700		MOVE AC1,XL+(I∧1)
02800		IMUL AC1,AA
02900		SUB AC0,AC1
03000		MOVE AC1,YL+((I∧2)⊗-1)
03100		IMUL AC1,BB
03200		SUB AC0,AC1
03300		IDIV AC0,CC
03400		CAMGE AC0,MINZ
03500		MOVE MINZ,AC0
03600		CAMLE AC0,MAXZ
03700		MOVE MAXZ,AC0
03800	⎇
03900	;Clip window's projected volume to the extreme volume of the triangle.
04000		HLRE AC0,3(T)
04100		HLRE AC1,4(T)
04200		CAMLE AC0,MINZ
04300		MOVE MINZ,AC0
04400		CAMGE AC1,MAXZ
04500		MOVE MAXZ,AC1
04600	
04700	
04800	JRST @OCCVOL
     

00100	;P.O.S.  -  Penetrator, Outsider, Surrounder.
00200	pos:
00300	comment/ POS determines the relationship between a triangle and a window
00400		and skips respectively.  For penetrators it always calculates 
00500		vertex-within-bits,  For Pen & Surs it always calculates volume.
00600			Accumulators IN:   XL,XH,YL,YH, & T(right half).
00700		/
00800	
00900	;GET TRIANGLE'S COORDINATES INTO ACCUMULATORS.
01000	define gettac {
01100		hlre x1,0(T)
01200		hlre x2,1(T)
01300		hlre x3,2(T)
01400		hrre y1,0(T)
01500		hrre y2,1(T)
01600		hrre y3,2(T)
01700	}
01800		gettac
01900	
02000	;If all the corners of the triangle are to one side of the window,
02100	; then the triangle is Outside.
02200	
02300	define Outside $ (M,N,P,HL) {
02400		CAM$M P$HL,P$1  ↔  JRST .+5
02500		CAM$M P$HL,P$2  ↔  JRST .+3
02600		CAM$N P$HL,P$3  ↔  JRST pnsout 
02700	}
02800		Outside LE,g,X,H
02900		Outside LE,g,Y,H
03000		Outside GE,l,X,L
03100		Outside GE,l,Y,L
03200	
03300	
03400	;If any vertex of the Triangle is within the window,
03500	;	then it is a penetrator.
03600				;EDGE CASES.
03700	For @$ N←1,3 {
03800	caml X$N,XH ↔JRST[CAMN X$N,XH ↔ IOR T,[1⊗(=21-N)]↔ jrst .+7]
03900	caml XL,X$N ↔JRST[CAMN XL,X$N ↔ IOR T,[1⊗(=21-N)]↔ jrst .+5]
04000	caml Y$N,YH ↔JRST[CAMN Y$N,YH ↔ IOR T,[1⊗(=21-N)]↔ jrst .+3]
04100	camg YL,Y$N ↔JRST[CAMN YL,Y$N↔JRST[IOR T,[1⊗(=21-N)]↔JRST .+1]↔ ior T,[1⊗(=36-N)]↔JRST .+1]
04200	}
04300	
04400		tlnn T,(7b2)
04500		jrst .+3
04600		jsr occvol		;Found a Penetrator.
04700		jrst @pns
04800	
04900	
     

00100	;SURROUNDS 
00200	
00300	comment/	For each edge of the triangle,  if for every corner of
00400		the window QQQ is the same sign then that edge does not pass 
00500		thru the window.  The odd vertex is in the opposite half plane
00600		from the window if the QQQs are all negative  -  which is
00700		equivalent to saying that the triangle is outside of the window.
00800		/
00900		jsr calq
01000		jrst pnsout		;OUTSIDE.
01100		tlne T,77770
01200		jrst [jsr occvol   ↔   jrst @pns]		;PENETRATOR.
01300		jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh	;lower ZH - SURROUNDER.
01400		aos pns
01500		aos pns
01600		jrst @pns
01700	
01800	;P.N.S  -  Penetrator, Nil list, Surrounder.
01900	pns:	0
02000	;Get pointer to next triangle, if list is empty or triangle is
02100	;beyond the back limit then take the NIL exit.
02200	pnsout:	skipe T,asur			;Check for ancestors.
02300		jrst [hlrzs T			;left SUR 1.
02400		      jumpe T,[exch T,asur	;right SUR 2
02500			       jrst pnssur]
02600		      hrrzs asur
02700		      jrst pnssur]
02800		skipe T,asur3
02900		jrst [setzm asur3
03000		      jrst pnssur]
03100		skipe T,apen
03200		jrst [hlrzs T			;left PEN 1
03300		      jumpe T,[exch T,apen	;right pen 2
03400			       jrst pos]
03500		      hrrzs apen
03600		      jrst pos]
03700		move TT,Triptr
03800	beyond:	aobjp TT,[aos pns
03900			  jrst @pns]
04000		movem TT,Triptr
04100		hrrz T,(TT)
04200		hlre (TT)
04300		caml zh
04400		jrst @beyond		;beyond ZH.
04500		jrst pos
04600	pnssur:	jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh	;lower Zh.
04700		aos pns			;surrounds
04800		aos pns
04900		jrst @pns
     

00100	;Calculate QQQ-bits, skip if not outside.
00200	calq:	0
00300			movsi PB,40000		;Select QQQ bit.
00400	define qqq (corner) {
00500			hlre ac1,AB
00600			hrre ac0,AB
00700			imul ac1,XL+ (corner ∧ 1)
00800			imul ac0,YL+((corner ∧ 2)⊗-1)
00900			add ac1,ac0
01000			add ac1,C
01100	}
01200	
01300	for  edge ← 1,3 {
01400			move AB,5+edge(T)	;Get line Coefficients
01500		IFE (edge-1),<hlre C,5(T)>
01600		IFE (edge-2),<hrre C,5(T)>
01700		IFE (edge-3),<hrre C,12(T)>
01800	for corner ← 0,3 {
01900		qqq corner
02000		skipge ac1		;Q sign convention - odd vertex positive.
02100		ior T,PB
02200		rot PB,-1
02300	}
02400	
02500		setcm ac1,T
02600		tlnn ac1,(17⊗(=33-edge*4))
02700		jrst @calq			;Triangle outside of window.
02800	}
02900		aos calq
03000		jrst @calq
     

00100	;Convert QQQ-bits into Pen-bits.
00200	CONQQQ:	0
00300		gettac
00400	;Accumulators  IN:  XL,XH,YL,YH  (the window)
00500	;		    X1,X2,X3,Y1,Y2,Y3 (the triangle)
00600	;		    T (the triangle pointer)
00700	;Accumulators clobbered 0,1,14,15.
00800		tlne T,(7B2)	;If a vertex is within, then we must calQ.
00900		jrst [		      jsr calq
01000		      jfcl
01100		      jrst .+1]
01200	for @$ edge←1,3 {
01300	BP←←2+edge*4	;Bit pointer for testing.
01400	V ←←((7-edge)*edge)/2	;non-edge select bits.
01500		setcm T		;If both vertices within,
01600		tlne (V ⊗=33)
01700		jrst .+3
01800		tlz T,(17⊗(=35-BP))	;Then zero NSEW byte.
01900		jrst conq$edge
02000	
02100	;Convert 4-bit byte by table lookup.
02200		ldb ac1,[point 4,T,BP]
02300		move [ 0 ↔ 12 ↔ 11 ↔ 3 ↔  6 ↔ 14 ↔ 0 ↔  5
02400		       5 ↔  0 ↔ 14 ↔ 6 ↔  3 ↔ 11 ↔ 12 ↔ 0](ac1)
02500		
02600		tlne T,(V ⊗ =33)	;If both vertices without
02700		jrst .+6
02800		dpb [point 4,T,BP]
02900		movei 1,V
03000		jsr skpcruz
03100		tlz T,(17⊗(=35-bp))	;no crossings - zip NSEW.
03200		jrst conq$edge	;Then we are done, Else:
03300	
03400	;Find vertex that is outside the window.
03500	selec1←←(IFE(1-edge),<1+>0)	;1,0,0 - first select.
03600	selec2←←(IFE(3-edge),<1+>1)	;2,2,1 - second select.
03700		tlne T,(1⊗(=35-selec1))
03800		;First selected bit is inside, hence second is outside.
03900		jrst [
04000		move XO,X1+selec2
04100		move YO,Y1+selec2
04200		jrst .+3]
04300	
04400		;First selected bit is outside.
04500		move XO,X1+selec1
04600		move YO,y1+selec1
04700	
04800	;Call one-crossing routine & you are done.
04900		jsr cross
05000		dpb [point 4,T,BP]
05100	conq$edge:
05200	}
05300	jrst @conqqq
     

00100	CROSS:	0
00200	
00300	comment /	The following tortured logic converts qqq-bits (which
00400		tell which half plane the window corners are in with respect
00500		to the lines determined by the triangle) into pen-bits (which 
00600		tell which sides of the window: North, South, East or West, each
00700		triangle edge segment crosses).
00800	
00900		Accumulators:  XO,YO & AC1.
01000		/
01100	
01200	;If the 2-bit is on
01300	trne 2  ↔  jrst [
01400	;then
01500	
01600		;If XO ≥ XH
01700		caml XO,XH  ↔  jrst [
01800		;Then 2-mask
01900			andi 2
02000			jrst @cross ]
02100		;Else 15-mask
02200			andi 15
02300			jrst @cross ]
02400	
02500	;Else
02600		;If 10-bit is on
02700		trne 10  ↔  jrst [
02800		;Then If YO ≥ YH
02900			caml YO,YH  ↔  jrst [
03000			;Then 10-mask
03100				andi 10
03200				jrst @cross]
03300			;Else 5-mask
03400				andi 5
03500				jrst @cross]
03600		;Else If XL > XO
03700			camle XL,XO  ↔ jrst [
03800			;Then 1-mask
03900				andi 1
04000				jrst @cross]
04100			;Else 4-mask
04200				andi 4
04300				jrst @cross
04400	
04500	;SKIPs if outsiders' edge crosses window.  No crossings - no Skippings.
04600	skpcruz:	0
04700	setz
04800	for @$ i←1,3 {
04900	camle x$i,XL 
05000	tro 1⊗(3-i)
05100	camle y$i,yl
05200	tro 1⊗(22-i)
05300	camle xh,x$i
05400	tlo 1⊗(3-i)
05500	camle yh,y$i
05600	tlo 1⊗(22-i)
05700	}
05800	tdnn 1	↔ jrst @skpcruz
05900	tsnn 1 	↔ jrst @skpcruz
06000	rot 3
06100	tdnn 1	↔ jrst @skpcruz
06200	tsnn 1	↔ jrst @skpcruz
06300	aos skpcruz
06400	jrst @skpcruz
     

00100	;Two Penetrators.
00200	;Is an edge possible 
00300	;Do both pen have no vertices within 
00400	.pp:	move T,pennew
00500		tlne T,(7B2)
00600		jrst %PP
00700		move TT,penold
00800		tlne TT,(7B2)
00900		jrst %PP
01000	MOVEM MINZ,MINZZ#
01100	MOVEM MAXZ,MAXZZ#
01200	
01300	;Does ONLY ONE and the same edge intersect the window for each pen
01400	.PP1:
01500	define edgep $ (NNN)  {
01600		jsr conqqq	;convert q-bits into pen-bits.
01700		movei 1
01800		movem en$nnn
01900		ldb [point 4,T,6]
02000		jumpn [	ldb 1,[point 8,T,14]
02100			jumpn 1,%PP
02200			jrst .+6]
02300		aos en$nnn
02400		ldb [point 4,T,10]
02500		jumpn [ldb 1,[point 4,t,14]
02600			jumpn 1,%PP
02700			jrst .+3]
02800		aos en$nnn
02900		ldb [point 4,T,14]
03000		movem ep$nnn
03100		movem T,IFE(nnn-1),<pennew> IFE(nnn-2),<penold>
03200	}
03300		edgep 1
03400		move T,penold
03500		edgep 2
03600		move TT,T
03700		move T,pennew
03800		came ep1
03900		jrst .+1	;Penetration bits do not match.
     

00100	;Are the edges' endpoints identical 
00200	.PP2:	move 1,en1	;edge new's number.
00300		hrrz new,T	;pennew pointers
00400		hrl  new,T
00500		hrrz old,TT	;penold pointers
00600		hrl  old,TT
00700	add new,[0 ↔ xwd 1,2 ↔ xwd 0,2 ↔ xwd 0,1](1)
00800		move 1,en2
00900	add old,[0 ↔ xwd 1,2 ↔ xwd 0,2 ↔ xwd 0,1](1)
01000		move (new)
01100		came (old)
01200		jrst [movss old
01300		      came (old)
01400		      jrst %PP	;match failure
01500		      jrst .+1]
01600		movss new
01700		movss old
01800		move (new)
01900		came (old)
02000		jrst %PP	;match failure.
02100	
02200	;Are odd vertices in opposite half planes 
02300	.PP3:
02400	comment /	Let's do this one by picking up pennew's
02500		line-coefficients and penold's odd-vertex and multiplying
02600		them together in order to look at Q's sign./
02700	
02800	;Get line coefficients for edge-pennew  1.
02900		move 1,en1
03000	xct    [0
03100		hlre C,5(T)
03200		hrre C,5(T)
03300		hrre C,12(T)](1)
03400		add 1,T
03500		move AB,5(1)
03600	
03700	;Get odd-vertex for edge-penold 2; x y z.
03800	.PP4:	move odd,en2
03900	xct    [0
04000		hlre 3(TT)
04100		hrre 3(TT)
04200		hlre 4(TT)](odd)
04300		movem zodd#	;save odd z-depth value.
04400		add odd,TT
04500		move odd,-1(odd)	;odd's x,,y.
04600	
     

00100	;Calculate QQQ.
00200	.PP5:	hlre ac1,AB
00300		hlre ac0,odd
00400		imul ac1,ac0	; a*X + ...
00500		hrre ac0,AB
00600		hrre AB,odd
00700		imul ac0,AB	; b*Y + ...
00800		add ac1,ac0
00900		add ac1,C	; c = qqq
01000		jumpge ac1,EdOver	;Edge's penetrators overlap.
01100	;Coplanar & No intensity turned on edge 
01200		move 1,en1
01300		ldb ibpt(1)
01400		jumpn .PP7
01500		move 1,en2
01600		ldb ibptt(1)
01700		jumpn .PP7
01800		TLNE T,7	;SPECIAL EDGE CASE.
01900		JRST .PP7
02000	;COPLANAR TEST.
02100	HLRE 11(T)↔MUL 13(TT)↔HLRE 14,11(TT)↔MUL 14,13(T)↔CAME 14↔JRST .PP7↔CAME 1,15↔JRST .PP7
02200	HRRE 11(T)↔MUL 13(TT)↔HRRE 14,11(TT)↔MUL 14,13(T)↔CAME 14↔JRST .PP7↔CAME 1,15↔JRST .PP7
02300	HLRE 12(T)↔MUL 13(TT)↔HLRE 14,11(TT)↔MUL 14,13(T)↔CAME 14↔JRST .PP7↔CAME 1,15↔JRST .PP7
02400	;Full Fledged Surrounder.
02500		move pennew
02600		hrlzm sur
02700		setzm pennew
02800		setzm penold
02900		move penzlo ↔ movem surzlo
03000		move penzhi ↔ movem surzhi
03100		camge ZH    ↔ movem ZH
03200		jrst .S
     

00100	;Final Edge Logic.
00200	.PP7:	MOVE MINZ,MINZZ ↔ MOVE MAXZ,MAXZZ
00300		camge minz,penzlo ↔ movem minz,penzlo
00400		camle maxz,penzhi ↔ movem maxz,penzhi
00500		move penzhi ↔ camge zh ↔ movem zh
00600				;pseudo-surrounder.
00700		move Triptr	;save pointer.
00800		movem Tpsav#
00900	.PP7a:	jsr pns
01000		jrst .PP8
01100		jrst epsilon
01200		skipe sur ↔ jrst [hrrm T,sur ↔ jrst .PP8]
01300		hrlzm T,sur
01400		caml minz,penzhi
01500		jrst .PP7a		;B
01600		caml maxz,penzlo
01700		jrst .PP8		;C
01800		setzm pennew		;F
01900		setzm penold
02000		movem minz,surzlo
02100		movem maxz,surzhi
02200		jrst .S
02300	;Final Edge Failure.
02400	.PP8:	move Tpsav
02500		movem Triptr
02600		jrst %PP
02700	;Edge Parametes
02800	en1:	0	;pennew's edge's number.
02900	en2:	0	;penold's edge's number.
03000	ep1:	0	;pennew's edge's pen-bits byte.
03100	ep2:	0	;penold's edge's pen-bits byte.
03200	;define intensity bit byte pointers.
03300	ibptt:	0
03400		point 1,4(TT),33
03500		point 1,4(TT),34
03600		point 1,4(TT),35
03700	ibpt:	0
03800		point 1,4(T),33
03900		point 1,4(T),34
04000		point 1,4(T),35
     

00100	;The two edge penetrators overlap,
00200	; that is the odd vertices are not in opposite halfplanes.
00300	EdOver:	MOVE MINZ,MINZZ ↔ MOVE MAXZ,MAXZZ
00400	comment/	We shall determine which penetrator is hidden by finding
00500		out which is deeper from the window.
00600	
00700		Accumulators IN: AA,BB,CC which contain the plane coefficients
00800					  of pennew leftover from occvol.
00900				 & ODD  odd vertex of penold.
01000	
01100		Also remember that  AA*x + BB*y + CC*z = kplane.
01200		/
01300		HLRE AA,11(T)
01400		HRRE BB,11(T)
01500		HLRE CC,12(T)
01600		move ac0,13(T)
01700		hlre ac1,odd
01800		imul ac1,AA
01900		sub ac0,ac1
02000		hrre ac1,odd
02100		imul ac1,BB
02200		sub ac0,ac1
02300		idiv ac0,CC
02400		camge ac0,zodd
02500	
02600	
02700	jrst [
02800	;Penold is hidden,  Pennew is a single penetrator.
02900		setzm penold ↔ movem minz,penzlo ↔ movem maxz,penzhi
03000		move 1,en2
03100		ldb ibptt(1)
03200		jumpe .P
03300		move 1,en1
03400		dpb ibpt(1)
03500	JRST .P
03600	]
03700	
03800	;Pennew is hidden,  Penold is a single penetrator.
03900		move 1,en1
04000		ldb ibpt(1)
04100		jumpe .+3
04200		move 1,en2
04300		dpb ibptt(1)
04400		movem TT,pennew
04500		setzm penold
04600		jrst .P
     

00100	;Save Father's surrounders  &  penetrators  and EXIT.
00200	%SSS: ↔ %PSS: ↔ %PPS: ↔ %PP: ↔ %PS:
00300		move 11,ZH
00400		hrl 11,sur3
00500		move 12,penold
00600		hrl 12,pennew
00700		move 13,sur
00800		move 14,triptr
00900	;Split up the window,  Recursion Exit.
01000	rexit:	move XM,XL
01100		move YM,YL
01200		add XM,XH
01300		add YM,YH
01400		ash XM,-1
01500		ash YM,-1
01600		camn XL,XM	;resolution 
01700		jrst owloop
01800		camn XH,XM
01900		jrst owloop
02000		move 6,sqrpdl	;setup blit pointer
02100		hrli 6,7
02200		move 15,6
02300		move 16,6
02400		move 17,6
02500		addi 16,6
02600		addi 17,14
02700		move  7,XH	;lower-right-window
02800		move 10,YM
02900		hrl   7,XM
03000		hrl  10,YL
03100		blt  15,5(6)
03200		movss 7		;lower-left-window
03300		hrl   7,XL
03400		blt  16,13(6)
03500		movss 10	;upper-left-window
03600		hrr   10,YH
03700		blt   17,21(6)
03800		addi   6,22
03900		HRRZM  6,sqrpdl	;update pdl pointer.
04000	;initialize OWL loop for upper-right window.
04100		move XL,XM
04200		move YL,YM
04300		movem 12,apen		;anscestors.
04400		movem 13,asur
04500		hlrzm 11,asur3
04600		setzm penold		;descendants.
04700		setzm pennew
04800		setzm sur
04900		setzm sur3
05000		jrst .V
05100	END
     

00100	TITLE PASS5
00200	EXTERNAL INPUT5,INPUT6,FFLAG,OUTPDL,END6
00300	INTERNAL PASS5
00400	;ACCUMULATORS
00500	XL←←0
00600	YL←←1
00700	XH←←2
00800	YH←←3
00900	X1←←B←←KK←←4
01000	Y1←←KKK←←5
01100	X2←←CC←←6
01200	Y2←←CCC←←Q←←7
01300	XM←←AAA←←10
01400	YM←←BBB←←11
01500	XN←←AA←←12
01600	YN←←BB←←13
01700	X←←14
01800	Y←←15
01900	P←←16
02000	A←←17
     

00100	PASS5:	0
00200		MOVEI P,INPUT5-1
00300		MOVE A,OUTPDL
00400		SUBI A,INPUT5-1
00500		MOVNS A
00600		HRL P,A
00700		MOVEM P,TEM1#
00800		MOVEI P,INPUT6
00900	LOOP:	HRRZ A,P
00905		SUBI A,END6
00910		SKIPL A
00915		JRST EXIT5	;OUTPUT BUFFER OVERFLOW.
00920		EXCH P,TEM1
01000		AOBJP P,EXIT5
01100		MOVE A,(P)
01200		AOBJP P,EXIT5
01300		HLRE XL,(P)
01400		HRRE YL,(P)
01500		MOVE XH,XL
01600		MOVE YH,YL
01700		HLRZ X,A
01800		ANDI X,177777
01900		ADD XH,X
02000		ADD YH,X
02100	
02200		EXCH P,TEM1
02300	
02310		SKIPE FFLAG	;TEST FRAME FLAG
02320		JSR FRAME
02330	
02400		TLNE A,600000
02500		JRST INTERS
02600	
02700		HRL A,4(A)	;PENETRATOR
02800	DEFINE UNPACK (N,M) {
02900	MOVE Y1,N-1(A)
03000	MOVE Y2,M-1(A)
03100	HLRE X1,Y1
03200	HLRE X2,Y2
03300	HRRES Y1
03400	HRRES Y2
03500	JSR CLIP
03600	⎇
03700	TLNE A,4
03800	JRST [UNPACK 2,3
03900		JRST .+1]
04000	TLNE A,2
04100	JRST [UNPACK 1,3
04200		JRST .+1]
04300	TLNE A,1
04400	JRST [UNPACK 1,2
04500		JRST .+1]
04600	JRST LOOP
04700	
04800	
04900	;INTERSECTING PLANES AND SURROUNDERS AND CORNERS
05000	INTERS:	EXCH P,TEM1
05100		AOBJP P,EXIT5
05200		MOVE B,(P)
05300		EXCH P,TEM1
05400		HLRE AA,11(A)
05500		HRRE BB,11(A)
05600		HLRE CC,12(A)
05700		HLRE AAA,11(B)
05800		HRRE BBB,11(B)
05900		HLRE CCC,12(B)
05950		MOVE KKK,13(B)
05975		MOVE KK,13(A)
06000	
06100		MOVM X,CC
06200		MOVM Y,CCC
06300		CAML X,Y
06400		JRST [EXCH CC,CCC
06405			EXCH KK,KKK
06410			EXCH AA,AAA
06420			EXCH BB,BBB
06430			JRST .+1
06440			]
06500		SKIPN CCC
06600		JRST LOOP
06610		ASH CC,22
06700		IDIVM CC,CCC
06710		MOVNS KKK
06720		MUL KKK,Q
06725		ASHC KKK,-22
06730		JFCL 17,.+1
06740		ADD KKK+1,KK
06800		IMUL AAA,Q
06900		IMUL BBB,Q
06910		ASH AAA,-22
06920		ASH BBB,-22
07000		SUB AA,AAA
07100		SUB BB,BBB
07200		MOVM X,AA
07300		MOVM Y,BB
07400		CAMG X,Y
07500		JRST INTERP
07600	
07700	MOVN X,XL
07710	IMUL X,BB
07740	ADD X,KKK+1
07760	IDIV X,AA
07770	MOVE X1,X
07780	
07790	MOVN X,YH
07800	IMUL X,BB
07830	ADD X,KKK+1
07850	IDIV X,AA
07860	MOVE X2,X
07870	MOVE Y2,YH
07880	MOVE Y1,YL
09000		JSR CLIP
09100		JRST LOOP
     

00100	INTERP:	MOVN X,XL
00110		IMUL X,AA
00140		ADD X,KKK+1
00160		IDIV X,BB
00170		MOVE X1,X
00180	
00190		MOVN X,XH
00200		IMUL X,AA
00230		ADD X,KKK+1
00250		IDIV X,BB
00260		
00270		MOVE Y2,X
00280		MOVE Y1,X1
00290		MOVE X1,XL
00300		MOVE X2,XH
01300		JSR CLIP
01400		JRST LOOP
     

00100	DEFINE FRAM $ (A,B,C,D) {
00110	MOVE X1,X$A
00120	MOVE Y1,Y$B
00130	SUB X1,X$C
00140	SUB Y1,Y$D
00150	HRL Y1,X1
00160	HRR Y,Y$D
00170	HRL Y,X$C
00180	PUSH P,Y
00190	PUSH P,Y1
00200	⎇
00210	FRAME:	0
00220	FRAM L,H,L,L
00230	FRAM H,H,L,H
00240	FRAM H,L,H,H
00250	FRAM L,L,H,L
00260	JRST @FRAME
00300	
00400	EXIT5:	EXCH P,TEM1
00500		MOVNS P	;LEFT HALF WORD APPEARS COMPLEMENTED & DECREMENTED
00600		HLLM P,INPUT6
00700		MOVEI P,INPUT6
00800		HRRM P,INPUT6
00900		JRST @PASS5
     

00100	;PASS5 LINE SEGMENT CLIPPING ROUTINE
00200	CLIP:	0
00300		HRREI X,-14
00400		MOVEM X,LIMIT2#
00500	CLIP3:	AOSL LIMIT2
00600		JRST @CLIP
00700	;EXIT IF BOTH END-POINTS ARE OUTSIDE
00800		CAMG X1,XH	;BOTH ABOVE XH
00900		JRST .+3
01000		CAMLE X2,XH
01100		JRST @CLIP
01200		CAMG Y1,YH	;BOTH ABOVE YH
01300		JRST .+3
01400		CAMLE Y2,YH
01500		JRST @CLIP
01600		CAML X1,XL	;BOTH BELOW XL
01700		JRST .+3
01800		CAMGE X2,XL
01900		JRST @CLIP
02000		CAML Y1,YL	;BOTH BELOW YL
02100		JRST .+3
02200		CAMGE Y2,YL
02300		JRST @CLIP
02400	
02500		CAMLE X1,XH	;IS (X1,Y1) WITHIN  
02600		JRST NO1
02700		CAMLE XL,X1
02800		JRST NO1
02900		CAMLE Y1,YH
03000		JRST NO1
03100		CAMLE YL,Y1
03200		JRST NO1
03300		CAMLE X2,XH	;IS (X2,Y2) WITHIN  
03400		JRST NO2
03500		CAMLE XL,X2
03600		JRST NO2
03700		CAMLE Y2,YH
03800		JRST NO2
03900		CAMLE YL,Y2
04000		JRST NO2
04100	CLIP2:	SUB X2,X1	;BOTH POINTS WITHIN; DISPLAY & EXIT.
04200		SUB Y2,Y1
04300		HRL Y1,X1
04400		HRL Y2,X2
04500		PUSH P,Y1
04600		PUSH P,Y2
04700		JRST @CLIP
04800	
04900	NO2:	MOVE XN,X1	;1 IN, 2 OUT.
05000		MOVE YN,Y1
05100		JSR N2
05200		JRST CLIP2
05300	
05400	NO1:	CAMLE X2,XH	;IS (X2,Y2) WITHIN 
05500		JRST NO3
05600		CAMLE XL,X2
05700		JRST NO3
05800		CAMLE Y2,YH
05900		JRST NO3
06000		CAMLE YL,Y2
06100		JRST NO3
06200		MOVE XM,X2	;2 IN, 1 OUT.
06300		MOVE YM,Y2
06400		JSR M1
06500		JRST CLIP2
06600	
06700	NO3:	MOVE XM,X1	;CALCULATE MIDPOINT
06800		MOVE YM,Y1
06900		ADD XM,X2
07000		ADD YM,Y2
07100		ASH XM,-1
07200		ASH YM,-1
07300		CAMLE XM,XH	;IS (XM,YM) WITHIN  
07400		JRST NO4
07500		CAMLE XL,XM
07600		JRST NO4
07700		CAMLE YM,YH
07800		JRST NO4
07900		CAMLE YL,YM
08000		JRST NO4
08100		MOVE XN,XM
08200		MOVE YN,YM
08300		JSR N2
08400		JSR M1
08500		JRST CLIP2
08600	
08700	NO4:	CAMG X1,XH	;BOTH ABOVE XH
08800		JRST .+3
08900		CAMLE XM,XH
09000		JRST NO5
09100		CAMG Y1,YH	;BOTH ABOVE YH
09200		JRST .+3
09300		CAMLE YM,YH
09400		JRST NO5
09500		CAML X1,XL	;BOTH BELOW XL
09600		JRST .+3
09700		CAMGE XM,XL
09800		JRST NO5
09900		CAML Y1,YL	;BOTH BELOW YL
10000		JRST .+3
10100		CAMGE YM,YL
10200		JRST NO5
10300		MOVE X2,XM
10400		MOVE Y2,YM
10500		JRST CLIP3
10600	NO5:	MOVE X1,XM
10700		MOVE Y1,YM
10800		JRST CLIP3
10900	
     

00100	N2:	0	;N IS IN, 2 IS OUT.
00200		HRREI X,-13
00300		MOVEM X,LIMIT#
00400	N2C:	AOSL LIMIT
00500		JRST @N2
00600		MOVE X,XN	;MIDPOINT
00700		MOVE Y,YN
00800		ADD X,X2
00900		ADD Y,Y2
01000		ASH X,-1
01100		ASH Y,-1
01200		CAME X,XN	;EXIT ON MATCH
01300		JRST N2B
01400		CAME Y,YN
01500		JRST N2B
01600	N2A:	MOVE X2,XN	;EXIT
01700		MOVE Y2,YN
01800		JRST @N2
01900	N2B:	CAME X,X2
02000		JRST .+3
02100		CAMN Y,Y2
02200		JRST N2A
02300		CAMLE X,XH	;IS (X,Y) WITHIN  
02400		JRST NON2
02500		CAMLE XL,X
02600		JRST NON2
02700		CAMLE Y,YH
02800		JRST NON2
02900		CAMLE YL,Y
03000		JRST NON2
03100		MOVE XN,X	;MIDPOINT WITHIN
03200		MOVE YN,Y
03300		JRST N2C
03400	NON2:	MOVE X2,X	;MIDPOINT OUTSIDE
03500		MOVE Y2,Y
03600		JRST N2C
     

00100	M1:	0	;M IS IN, 1 IS OUT.
00200		HRREI X,-13
00300		MOVEM X,LIMIT#
00400	M1C:	AOSL LIMIT
00500		JRST @M1
00600		MOVE X,XM	;MIDPOINT
00700		MOVE Y,YM
00800		ADD X,X1
00900		ADD Y,Y1
01000		ASH X,-1
01100		ASH Y,-1
01200		CAME X,XM	;EXIT ON MATCH
01300		JRST M1B
01400		CAME Y,YM
01500		JRST M1B
01600	M1A:	MOVE X1,XM	;EXIT
01700		MOVE Y1,YM
01800		JRST @M1
01900	M1B:	CAME X,X1
02000		JRST .+3
02100		CAMN Y,Y1
02200		JRST M1A
02300		CAMLE X,XH	;IS (X,Y) WITHIN  
02400		JRST NOM1
02500		CAMLE XL,X
02600		JRST NOM1
02700		CAMLE Y,YH
02800		JRST NOM1
02900		CAMLE YL,Y
03000		JRST NOM1
03100		MOVE XM,X	;MIDPOINT WITHIN
03200		MOVE YM,Y
03300		JRST M1C
03400	NOM1:	MOVE X1,X	;MIDPOINT OUTSIDE
03500		MOVE Y1,Y
03600		JRST M1C
03700	
03800	END
     

00100	;OUTPUT TO ARDS & BYPASS 
00200	TITLE PASS6
00300	EXTERNAL INPUT6,INPUT3,NUMTRI
00400	INTERNAL PASS6,BYPASS
00500	OPDEF OUTCHR[XWD 51040,0]
00600	;ACCUMULATORS
00700	P←1
00800	X←2
00900	Y←3
01000	X2←4
01100	Y2←5
01200	A←6
01300	FLAG←7
01400	PASS6:	0
01500		MOVE P,INPUT6
01600	LOOP2:	SETZM FLAG
01700	LOOP:	AOBJP P,EXIT6
01800		OUTCHR [35]	;DOT
01900		HLRE X,(P)
02000		JSR ARDS
02100		HRRE X,(P)
02200		JSR ARDS
02300		OUTCHR [36]	;VECTOR
02400		AOBJP P,EXIT6
02500	
02600		HLRE X,(P)
02700		HRRE Y,(P)
02800		MOVM A,X
02900		CAIL A,2000
03000		JSR TWOVEC
03100		MOVM A,Y
03200		CAIL A,2000
03300		JSR TWOVEC
03400		JSR ARDS
03410		MOVE X,Y
03420		JSR ARDS
03500		JUMPE FLAG,LOOP
03600		MOVE X,X2
03700		JSR ARDS
03800		MOVE X,Y2
03900		JSR ARDS
04000		JRST LOOP2
04100	
04200	TWOVEC:	0
04300		SETOM FLAG
04400		MOVE X2,X
04500		MOVE Y2,Y
04600		ASH X,-1
04700		ASH Y,-1
04800		SUB X2,X
04900		SUB Y2,Y
05000		JRST @TWOVEC
05100	EXIT6:	OUTCHR [15]
05200		JRST @PASS6
     

00100	ARDS:	0
00200		MOVM A,X
00300		ASH A,1
00400		SKIPGE X
00500		TRO A,1	;SIGN BIT
00600		ANDI A,77
00700		IORI A,100
00800		OUTCHR A
00900		MOVM A,X
01000		ASH A,-5
01100		ANDI A,37
01200		IORI A,100
01300		OUTCHR A
01400		JRST @ARDS
     

00100	X1←2
00200	Y1←3
00300	X3←10
00400	Y3←11
00500	II←12
00600	A1←13
00700	A2←14
00800	A3←15
00900	BYPASS:	0		;BYPASS OCCULT LINE ELIMINATION
01000		MOVE A1,NUMTRI
01100		MOVEI A2,INPUT6
01200	LOOP3:	SKIPN A1
01300		JRST [ MOVEI INPUT6
01400			MOVEM INPUT6
01500			HLRZ A1,A2
01600			MOVNS A1
01650			SOS A1
01700			HRLM A1,INPUT6
01800			JRST @BYPASS]
01900		SOS A3,A1
02000		IMULI A3,5
02100		ADDI A3,INPUT3
02200		HLRE X1,0(A3)
02300		HRRE Y1,0(A3)
02400		HLRE X2,1(A3)
02500		HRRE Y2,1(A3)
02600		HLRE X3,2(A3)
02700		HRRE Y3,2(A3)
02800		HRRZ II,4(A3)
02900	
     

00100	DEFINE PUTOUT $ (N,M)
00200	{
00300	PUSH A2,N-1(A3)
00400	SUB X$M,X$N
00500	SUB Y$M,Y$N
00600	HRL Y$M,X$M
00700	PUSH A2,Y$M
00710	HLRE X$M,M-1(A3)
00720	HRRE Y$M,M-1(A3)
00800	⎇
00900	
03000		TRNE II,4
03100		JRST [
03150		PUTOUT 2,3
03175		JRST .+1]
03200		TRNE II,2
03300		JRST [
03350		PUTOUT 1,3
03375		JRST .+1]
03400		TRNE II,1
03500		JRST [
03550		PUTOUT 1,2
03575		JRST .+1]
03600		JRST LOOP3
03700	
04200	END
     

00100	TITLE DATA
00200	INTERNAL NUMTRI,TRIBLKS,TRITAB,INPUT3,INPUT6,FFLAG,INPUT5,OUTPDL
00300	INTERNAL  ENDPDL,END6
00400	NUMTRI:	20
00500	TRIBLKS:	0
00600	BLOCK 400
00700	TRITAB:	0
00800	BLOCK 40
00900	INPUT3:
01000	DEFINE TRIANG (X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,N)
01100	{
01200	XWD X1,Y1
01300	XWD X2,Y2
01400	XWD X3,Y3
01500	XWD Z1,Z2
01600	XWD Z3,N
01700	⎇
01800	
01900	DEFINE QUAD (X1,Y1,X2,Y2,Z12,X3,Y3,X4,Y4,Z34)
02000	{
02100	TRIANG X1,Y1,Z12,X2,Y2,Z12,X3,Y3,Z34,5
02200	TRIANG X1,Y1,Z12,X3,Y3,Z34,X4,Y4,Z34,6
02300	⎇
02400	
02500	QUAD -500,-700,-500,-200, 200, 440,-200, 440,-700,200
02600	QUAD -440,-100,-440, 200, 600, 300, -40,300,-600, 100
02700	QUAD 0,100,0,500,100,440,500,440,100,100
02800	QUAD -440,400,-440,700,600,-240,700,-240,400,600
02900	QUAD 0,500,440,500,100,-240,700,-440,700,600
03000	QUAD 0,100,440,100,100,-240,400,-440,400,600
03100	QUAD 440,100,440,500,100,-240,700,-240,400,600
03200	QUAD 0,100,0,500,100,-440,700,-440,400,600
03205	
03210	FFLAG:	-1	;FRAME FLAG
03215	OUTPDL:	.+3
03220		
03225	INPUT5:	XWD 1200,INPUT3
03230		XWD -500,-500
03235		BLOCK 14000
03236	ENDPDL:	0	↔	0	↔	0	↔	0
03240	INPUT6:	0
03260	BLOCK 40000
03261	END6:	0 ↔ 0 ↔ 0 ↔ 0
03300	END